home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / nrcobol_1e.lha / NRCOBOL1e / COBFILES / insure.cob < prev    next >
Text File  |  1997-06-25  |  17KB  |  426 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  INSURE.
  3.       *PROGRAM DISCRIPTION.
  4.        ENVIRONMENT DIVISION.
  5.        CONFIGURATION SECTION.
  6.        SOURCE-COMPUTER.
  7.        OBJECT-COMPUTER.
  8.        INPUT-OUTPUT SECTION.
  9.        FILE-CONTROL.
  10.            SELECT CLIENT-FILE ASSIGN TO DISK
  11.            ORGANIZATION IS LINE SEQUENTIAL
  12.            ACCESS MODE IS SEQUENTIAL
  13.            FILE STATUS IS WS-FILE-STATUS.
  14.       *
  15.            SELECT CLIENT-PRINT ASSIGN TO PRINTER
  16.            ORGANIZATION IS SEQUENTIAL
  17.            ACCESS MODE IS SEQUENTIAL
  18.            FILE STATUS IS WS-PRINT-STATUS.
  19.       *
  20.        DATA DIVISION.
  21.        FILE SECTION.
  22.        FD CLIENT-FILE
  23.            LABEL RECORDS STANDARD
  24.            VALUE OF FILE-ID IS "CLIENT.DAT".
  25.        01  IN-CLIENT-REC.
  26.            03  ER-CLAIM-NUMBER          PIC 999V9(4).
  27.            03  ER-CLASS-CODE            PIC 9(6).
  28.            03  ER-REGION                PIC X(4).
  29.            03  ER-PREV-CLAIMS           PIC 99.
  30.            03  ER-PREV-CLAIMS-TOTAL     PIC 9(9).
  31.            03  ER-AMOUNT-CLAIMED        PIC 9(7).
  32.       *
  33.        FD CLIENT-PRINT
  34.            LABEL RECORDS OMITTED.
  35.        01 OUT-CLIENT-REC.
  36.            03 FILLER                     PIC A(80).
  37.       *
  38.        WORKING-STORAGE SECTION.
  39.        01 WS-COUNTERS.
  40.            03 WS-PAGE-COUNT      PIC 99 VALUE 00.
  41.            03 WS-LINE-COUNT      PIC 99 VALUE 00.
  42.            03 WS-CLAIMS-TOTAL        PIC 9(9).
  43.            03 WS-CLAIMS-NUM-TOTAL    PIC 999.
  44.            03 WS-AVERAGE-CLAIM       PIC 9(7).
  45.        01 WS-STOP-RUN-FLAG       PIC X  VALUE " ".
  46.        01 WS-END-FILE-FLAG       PIC X  VALUE " ".
  47.        01 WS-FILE-STATUS         PIC XX VALUE "00".
  48.        01 WS-PRINT-STATUS        PIC XX VALUE "00".
  49.       *
  50.        01 WS-TITLE-1.
  51.            03 FILLER  PIC X(22)  VALUE "ASSIGNMENT    10/08/89".
  52.            03 FILLER  PIC X(5)   VALUE SPACES.
  53.            03 FILLER  PIC X(26)  VALUE "FAIL SAFE INSURANCE AGENCY".
  54.            03 FILLER  PIC X(5)   VALUE SPACES.
  55.            03 WS-TITLE-DATE      PIC X(8).
  56.            03 FILLER             PIC X(7).
  57.            03 FILLER             PIC X(5)   VALUE "PAGE ".
  58.            03 WS-TITLE-PAGE-NO   PIC 99.
  59.        01 WS-TITLE-3.
  60.            03 FILLER  PIC X(29)  VALUE SPACES.
  61.            03 FILLER  PIC X(22)  VALUE "INSURANCE CLAIM REPORT".
  62.        01 WS-HEADER-4.
  63.            03 FILLER  PIC X(12)  VALUE "CLAIM NUMBER".
  64.            03 FILLER  PIC X(12)  VALUE SPACES.
  65.            03 FILLER  PIC X(6)   VALUE "REGION".
  66.            03 FILLER  PIC X(12)  VALUE SPACES.
  67.            03 FILLER  PIC X(13)  VALUE "TOTAL CLAIMED".
  68.            03 FILLER  PIC X(10)  VALUE SPACES.
  69.            03 FILLER  PIC X(15)  VALUE "AMOUNT OF CLAIM".
  70.        01 WS-HEADER-5.
  71.            03 FILLER  PIC X(13)  VALUE SPACES.
  72.            03 FILLER  PIC X(10)  VALUE "CLASS CODE".
  73.            03 FILLER  PIC X(6)   VALUE SPACES.
  74.            03 FILLER  PIC X(15)  VALUE "PREVIOUS CLAIMS".
  75.            03 FILLER  PIC X(8)   VALUE SPACES.
  76.            03 FILLER  PIC X(16)  VALUE "AVERAGED CLAIMED".
  77.        01 WS-INSURENCE-REC.
  78.            03 FILLER             PIC X(3)   VALUE SPACES.
  79.            03 FLD-CLAIM-NUMBER   PIC 999V9(4).
  80.            03 FILLER             PIC X(5)   VALUE SPACES.
  81.            03 FLD-CLASS-CODE     PIC X(6).
  82.            03 FILLER             PIC X(4)   VALUE SPACES.
  83.            03 FLD-REGION         PIC X(6).
  84.            03 FILLER             PIC X(6)   VALUE SPACES.
  85.            03 FLD-PREV-CLAIMS    PIC Z9.
  86.            03 FILLER             PIC X(5)   VALUE SPACES.
  87.            03 FLD-PREV-CLAIMS-TOTAL  PIC Z(8)9.
  88.            03 FILLER             PIC X(5)   VALUE SPACES.
  89.            03 FLD-AVG-CLAIMED    PIC Z(6)9.
  90.            03 FILLER             PIC X(5)   VALUE SPACES.
  91.            03 FLD-AMOUNT-CLAIMED PIC Z(8)9.
  92.       *
  93.        01 WS-TOTALS-1.
  94.            03 FILLER             PIC X(35)  VALUE SPACES.
  95.            03 FILLER             PIC X(22)  VALUE
  96.                          "CURRENT TOTAL CLAIMS :".
  97.            03 TOTALS-CURR-CLAIMS PIC ZZZ,ZZZ,ZZ9.
  98.        01 WS-TOTALS-2.
  99.            03 FILLER             PIC X(35)  VALUE SPACES.
  100.            03 FILLER             PIC X(22)  VALUE
  101.                          "NUMBER OF CLAIMS     :".
  102.            03 TOTALS-MAX-CLAIMS  PIC ZZ9.
  103.        01 WS-TOTALS-3.
  104.            03 FILLER             PIC X(35)  VALUE SPACES.
  105.            03 FILLER             PIC X(22)  VALUE
  106.                          "AVERAGE CLAIM        :".
  107.            03 TOTALS-AVG-CLAIMS  PIC Z,ZZZ,ZZ9.
  108.  
  109.  
  110.        01 WS-REAL-DATE.
  111.            03 WS-REAL-YEAR       PIC XX.
  112.            03 WS-REAL-MONTH      PIC XX.
  113.            03 WS-REAL-DAY        PIC XX.
  114.        01 WS-TEMP-DATE.
  115.            03 WS-TEMP-DAY        PIC XX.
  116.            03 FILLER             PIC X    VALUE  "/".
  117.            03 WS-TEMP-MONTH      PIC XX.
  118.            03 FILLER             PIC X    VALUE  "/".
  119.            03 WS-TEMP-YEAR       PIC XX.
  120.        01 WS-CLIENT-REC.
  121.            03  WS-CLAIM-NUMBER          PIC 999V9(4).
  122.            03  WS-CLASS-CODE            PIC 9(6).
  123.            03  WS-REGION                PIC X(4).
  124.            03  WS-PREV-CLAIMS           PIC 99.
  125.            03  WS-PREV-CLAIMS-TOTAL     PIC 9(9).
  126.            03  WS-AMOUNT-CLAIMED        PIC 9(7).
  127.       *
  128.        01 WS-RESPONCE            PIC X.
  129.            88 WS-RESPONCE-S             VALUE "S" "s".
  130.            88 WS-RESPONCE-P             VALUE "P" "p".
  131.            88 WS-RESPONCE-Q             VALUE "Q" "q".
  132.       *
  133.        SCREEN SECTION.
  134.        01 BLANK-SCREEN.
  135.            03 BLANK SCREEN.
  136.        01 BLANK-LINE.
  137.            03 BLANK LINE.
  138.        01 PROG-DISCRIPTION.
  139.        01 PRINTING-DOC-MESSG.
  140.            03 LINE 3 COLUMN 8        VALUE   "PAGE ".
  141.            03 LINE 3 COLUMN 13       PIC 99   FROM  WS-PAGE-COUNT.
  142.            03 LINE 3 COLUMN 15       VALUE
  143.                    " OF RECORD IS NOW BEING PRINTED".
  144.        01 PROG-FINISH.
  145.            03 LINE 24 COLUMN 8       VALUE
  146.                    "TASK COMPLETE".
  147.        01 MENU.
  148.            03 LINE 10 COLUMN 30   VALUE "MENU".
  149.            03 LINE 11 COLUMN 30   VALUE "----".
  150.            03 LINE 15 COLUMN 19   VALUE "PRESS 'P' to list to PRINTER".
  151.            03 LINE 17 COLUMN 19   VALUE "      'S' to list to SCREEN ".
  152.            03 LINE 19 COLUMN 19   VALUE "      'Q' to quit    MENU   ".
  153.        01 RESPONCE-LINE.
  154.            03 LINE 22 COLUMN 19   PIC X
  155.              TO WS-RESPONCE AUTO.
  156.       *
  157.        01 DIS-TITLE.
  158.            03 LINE 1 COLUMN 1    VALUE "ASSIGNMENT    10/08/89".
  159.            03 LINE 1 COLUMN 28   VALUE "FAIL SAFE INSURANCE AGENCY".
  160.            03 LINE 1 COLUMN 58   PIC X(8)  FROM WS-TEMP-DATE.
  161.  
  162.            03 LINE 1 COLUMN 71   VALUE "PAGE ".
  163.            03 LINE 1 COLUMN 76   PIC 99 FROM WS-PAGE-COUNT.
  164.            03 LINE 3 COLUMN 30   HIGHLIGHT  VALUE
  165.               "INSURANCE CLAIM REPORT".
  166.        01 DIS-HEADER.
  167.            03 LINE 5 COLUMN 1    VALUE "CLAIM NUMBER".
  168.            03 LINE 6 COLUMN 14   VALUE "CLASS CODE".
  169.            03 LINE 5 COLUMN 24   VALUE "REGION".
  170.            03 LINE 6 COLUMN 31   VALUE "PREVIOUS CLAIMES".
  171.            03 LINE 5 COLUMN 42   VALUE "TOTAL CLAIMED".
  172.            03 LINE 6 COLUMN 55   VALUE "AVERAGED CLAIMED".
  173.            03 LINE 5 COLUMN 66   VALUE "AMOUNT OF CLAIM".
  174.        01 NEW-PAGE.
  175.            03 LINE 25 COLUMN 3   VALUE "PRESS ANY KEY FOR NEXT PAGE".
  176.        01 ANY-KEY.
  177.            03 LINE 25 COLUMN 31  PIC X TO WS-RESPONCE AUTO.
  178.      *
  179.        01 ERROR-MESSAGES.
  180.            03 LINE 21 COLUMN 8   VALUE "FILE WOULD NOT OPEN :".
  181.            03 LINE 22 COLUMN 8   VALUE "STATUS ERROR CODE   :".
  182.            03 LINE 22 COLUMN 29  HIGHLIGHT PIC XX
  183.               FROM WS-FILE-STATUS.
  184.            03 LINE 23 COLUMN 8   VALUE "STATUS ERROR CODE   :".
  185.            03 LINE 23 COLUMN 29  HIGHLIGHT PIC XX
  186.               FROM WS-PRINT-STATUS.
  187.       *
  188.        PROCEDURE DIVISION.
  189.       *
  190.       *********************************************************
  191.       *  Paragraph to open CLIENT-FILE for import and CLIENT-PRINT
  192.       * for export.Should the either file's status be in error,
  193.       * the files are closed and an error message printed along
  194.       * with the status value, Other wise 1000-DISPLAY is called.
  195.       *
  196.        0000-MAIN.
  197.            OPEN INPUT  CLIENT-FILE.
  198.       *     OPEN OUTPUT CLIENT-